IRIS Performer 2.2 Friends Demo/SGI IRIS Performer 2.2 Friends Demo.iso/friends/openworlds/tix/DirTree.tcl

Text File | 1997-11-22 | 6KB | 253 lines

tixWidgetClass tixDirTree {
    -classname TixDirTree
    -superclass tixScrolledHList
    -method {
    chdir activate
    }
    -flag {
    -browsecmd -command -directory -disablecallback -showhidden
    }
    -configspec {
    {-browsecmd browseCmd BrowseCmd {}}
    {-command command Command {}}
    {-directory directory Directory {}}
    {-disablecallback disableCallback DisableCallback false}
    {-showhidden showHidden ShowHidden false}
    }
    -default {
    {.scrollbar            auto}
    {*Scrollbar.background          #d9d9d9}
    {*Scrollbar.relief              sunken}
    {*Scrollbar.takeFocus           0}
    {*Scrollbar.troughColor         #c3c3c3}
    {*Scrollbar.width               15}
    {*borderWidth                   1}
    {*hlist.background              #c3c3c3}
    {*hlist.drawBranch              1}
    {*hlist.height                  10}
    {*hlist.highlightBacground      #d9d9d9}
    {*hlist.indent                  15}
    {*hlist.itemType                imagetext}
    {*hlist.padX                    3}
    {*hlist.padY                    0}
    {*hlist.relief                  sunken}
    {*hlist.takeFocus               1}
    {*hlist.wideSelection           0}
    {*hlist.width                   20}
    }
}

proc tixDirTree::InitWidgetRec {w} {
    upvar #0 $w data

    tixChainMethod $w InitWidgetRec

    set data(oldDir) {{}}

    if {$data(-directory) == {}} {
    global env
    if {[info exists env(PWD)]} {
        set data(-directory) $env(PWD)
    } else {
        set data(-directory) [pwd]
    }
    }
}

proc tixDirTree::ConstructWidget {w} {
    upvar #0 $w data

    tixChainMethod $w ConstructWidget
    tixDoWhenIdle tixDirTree::StartUp $w

    $data(w:hlist) config \
    -separator "/" \
    -selectmode "single" -drawbranch 1
}

proc tixDirTree::SetBindings {w} {
    upvar #0 $w data

    tixChainMethod $w SetBindings

    $data(w:hlist) config \
    -browsecmd "tixDirTree::Browse $w" \
    -command "tixDirTree::ChangeDir $w"
    bind $data(w:hlist) <3> "tixDirTree::DeleteSib $w %x %y"
}

proc tixDirTree::DeleteSib {w x y} {
    upvar #0 $w data

    set ent [$data(w:hlist) nearest $y]

    if {$ent != ""} {
    $data(w:hlist) anchor set $ent

    for {set e $ent} {$e != "/"} {set e [$data(w:hlist) info parent $e]} {
        $data(w:hlist) delete siblings $e
    }
    tixDirTree::Browse $w $ent
    }
}

proc tixDirTree::AddDir {w dir} {
    upvar #0 $w data

    if [$data(w:hlist) info exists $dir] {
    return
    }

    if {$dir != "/"} {
    set parentDir [file dirname $dir]
    if {![$data(w:hlist) info exists $parentDir]} {
        tixDirTree::AddDir $w $parentDir
    }
    $data(w:hlist) add $dir -text [file tail $dir] \
        -image [tix getimage openfolder]

    $data(w:hlist) entryconfig $parentDir -data loaded
    } else {
    $data(w:hlist) add $dir -text / \
        -image [tix getimage openfolder]
    }
}

proc tixDirTree::ListDirs {w dir} {
    upvar #0 $w data

    set appPWD [pwd]

    if [catch {cd $data(-directory)} err] {
    # The user has entered an invalid directory
    # %% todo: prompt error, go back to last succeed directory
    cd $appPWD
    return
    }

    if [tixGetBoolean -nocomplain $data(-showhidden)] {
    if [catch {set names [lsort [glob -nocomplain * .*]]} err] {
        # Cannot read directory
        # %% todo: show directory permission denied
        cd $appPWD
        return
    }
    } else {
    if [catch {set names [lsort [glob -nocomplain *]]} err] {
        cd $appPWD
        return
    }
    }

    set dirs 0

    foreach fname $names {
    if {![string compare . $fname] || ![string compare .. $fname]} {
        continue
    }
    if {$data(-directory) == "/"} {
        set subdir /$fname
    } else {
        set subdir $data(-directory)/$fname
    }
    if [file isdirectory $subdir] {
        $data(w:hlist) add $subdir -text $fname \
        -image [tix getimage folder]
        incr dirs
    }
    }

    if {$dirs > 0} {
    $data(w:hlist) entryconfig $dir -data loaded
    }

    cd $appPWD
}

proc tixDirTree::LoadDir {w dir {mode toggle}} {
    if {![winfo exists $w]} {
    return
    }

    upvar #0 $w data

    if {$data(oldDir) != {} && [$data(w:hlist) info exists $data(oldDir)]} {
    if {[$data(w:hlist) info data $data(oldDir)] == {}} {
        $data(w:hlist) entryconfig $data(oldDir) \
        -image [tix getimage folder]
    } else {
        $data(w:hlist) entryconfig $data(oldDir) \
        -image [tix getimage openfolder]
    }
    }

    # Add the directory and set it to the active directory
    #
    set data(oldDir) $dir
    tixDirTree::AddDir $w $dir
    $data(w:hlist) entryconfig $dir -image [tix getimage act_folder]

    if {$mode == "toggle"} {
    if {[$data(w:hlist) info children $dir] == {}} {
        set mode expand
    } else {
        set mode flatten
    }
    }

    if {$mode == "expand"} {
    tixDirTree::ListDirs $w $dir
    } else {
    $data(w:hlist) delete offsprings $dir
    }
}

proc tixDirTree::ChangeDir {w value} {
    upvar #0 $w data

    set data(-directory) $value
    tixDoWhenIdle tixDirTree::LoadDir $w $value

    if {$data(-command) != {} &&
    ![tixGetBoolean -nocomplain $data(-disablecallback)]} {
    eval $data(-command) [list $data(-directory)]
    }
}

proc tixDirTree::StartUp {w} {
    if {![winfo exists $w]} {
    return
    }

    upvar #0 $w data

    tixDirTree::LoadDir $w $data(-directory)
}

proc tixDirTree::Browse {w dir} {
    upvar #0 $w data

    if {$data(-browsecmd) != {}} {
    eval $data(-browsecmd) [list $dir]
    }
}

# Public methods
#
#
proc tixDirTree::chdir {w dir} {
    upvar #0 $w data

    set data(-directory) $dir
    tixDoWhenIdle tixDirTree::LoadDir $w $dir expand

    if {$data(-command) != {} &&
    ![tixGetBoolean -nocomplain $data(-disablecallback)]} {
    eval $data(-command) [list $data(-directory)]
    }
}

proc tixDirTree::config-directory {w value} {
    tixDirTree::chdir $w $value
}